perm filename SCORZ.F4[TMP,LCS]2 blob
sn#131237 filedate 1974-11-15 generic text, type T, neo UTF8
C THIS PROGRAM IS THE PROPERTY OF LELAND SMITH, PROFESSOR OF MUSIC
C AT STANFORD UNIVERSITY. IT MAY NOT BE COPIED OR ALTERED IN ANY
C WAY WITHOUT WRITTEN PERMISSION OF THE AUTHOR.
C 7/74 ********** SCORE ********** LELAND SMITH, SEP.1969
C THIS PROGRAM WRITES NOTE LISTS FOR THE PDP10 SOUND
C GENERATION PROGRAM.
C IF # OF INSTS IS CHANGED, ALSO CHANGE # IN 'INFO' FORMAT.
C LOAD 'SCORE' WITH BRZ.REL (RAN. NUM GENERATOR),SPRINT.MAC AND,
C SCANW, (AND QUAD AND QUADO WHEN THEY ARE READY) AND
C IF DESIRED, A SUBROUTINE WITH THE FOLLOWING HEADING:
C SUBROUTINE SUBR
C COMMON /INS/ INST(27),BG(60)
C COMMON P(30),INUM,IPAR,CNT(27),BT,PL(48),IREST,DF,DUR(27)
C INUM=INST# IPAR=PARAM#
C BT=BASIC TIME P1 WHEN SUBROUTINE IS CALLED
C IF IREST IS <0, THAT NOTE WILL BE A REST.
C INST=INST. NAME, BG=INSTS' BEGIN TIMES.
C NOTE #S IN SUBROUTINE: (1-84) C4=37 FS4=43 C5=49 ETC.
C F1=86 F15=100 (NO F16!)
COMMON /Q/ BNW(100),NWZ /INS/INST,BG /TYP/SOS,JOUT
CC 7/74 COLGATE COMMON/TYP/ IS FOR COLTTY ROUT.
DIMENSION ROFF(27),V(2000),NP(27),PCH(27,32),INST(27)
1 ,RDEV(27),IPT(27,31),XT(27),BG(60),OTH(20,16),SCAL(101)
1 ,IV(2000),NCNT(27,32),P1(27),IT(30),JFM(4),JNP(80)
1 ,IOUT(70),IFM(80),COPY(30),LIST(78),JPT(837)
1 ,FINM(6),TINST(5),TPALN(4),ENFI(5),TEDIT(4),INVIS(27)
C WITH VX,IOUT AT 70 AND IFM AT 80 OK FOR ONLY
C 40 LIT CHARS + 30 PARAMS PER INST.
C 60 BG TIMES AVAILABLE. FOR INSTS AND INSERTS AND EDITS.
COMMON P(30),J,L,CNT(27),BT,PL(48),MK,DF,DUR(27)
1 ,IQ(27),KL,X,ZPAR,KA,LK,NNUM,JJ,JA,ISUB,NFLG,IXX,ISEMI,IQT
1 ,INP(72),VX(70),ISCA(12),IDAT(11),IAMP,K,KN,M,ML,CODE,IBLA
EQUIVALENCE (PP1,P(1)),(P(2),P2),(P(3),P3),(P(4),P4),
1 (VX1,VX(1)),(INP1,INP(1)),(PL4,PL(4)),(IPP,ISCA(2))
1 ,(IEN,ISCA(4)),(IPT,JPT),(ISS,ISCA(9)),(ITT,ISCA(11))
1 ,(IE,ISCA(5)),(ID,ISCA(3)),(IF,ISCA(6)),(IAA,ISCA(10))
1 ,(VX2,VX(2)),(VX3,VX(3)),(NCNT,PCH),(VX4,VX(4)),(INP,JNP)
1 ,(VX5,VX(5)),(IDOT,IDAT(11)),(VX,IOUT),(IFM3,IFM(3))
1 ,(IT,INP(27)),(V,IV),(PLAY,ISCA(7)),(IFM2,IFM(2))
1 ,(IFM4,IFM(4)),(IFM(3),LIST)
DATA KZY/27/,ISEMI/';'/,RTF/.05/,IQT/'"'/
1, JFM(3)/','/
C IAA=A ID=D IE=E IF=F IEN=N IPP=P ISS=S ITT=T
DATA KSLA/'/'/,IBLA/' '/,BLA/' '/,IXX/'X'/,ITMPO/'TEMPO'/
1 ,ISCA/'C','P','D','N','E','F','PLAY;','G','S','A','T','B'/
1 ,IDAT/'0','1','2','3','4','5','6','7','8','9','.'/
1 ,SCAL/'C/8','CS/8','D/8','DS/8','E/8','F/8','FS/8','G/8',
1 'GS/8','A/8','AS/8','B/8','C/4','CS/4','D/4','DS/4','E/4',
1 'F/4','FS/4','G/4','GS/4','A/4','AS/4','B/4','C/2','CS/2',
1 'D/2','DS/2','E/2','F/2','FS/2','G/2','GS/2','A/2','AS/2',
1 'B/2','C','CS','D','DS','E','F','FS','G','GS','A','AS',
1 'B','C*2','CS*2','D*2','DS*2','E*2','F*2','FS*2','G*2',
1 'GS*2','A*2','AS*2','B*2','C*4','CS*4','D*4','DS*4','E*4',
1 'F*4','FS*4','G*4','GS*4','A*4','AS*4','B*4','C*8','CS*8',
1 'D*8','DS*8','E*8','F*8','FS*8','G*8','GS*8','A*8','AS*8',
1 'B*8','R','F1','F2','F3','F4','F5','F6','F7','F8','F9',
1 'F10','F11','F12','F13','F14','F15','END'/,I1X/'1X'/
1 ,IFM(1)/'('/,IFM2/'1XA5,'/,IFCOM/5H', ',/,IA1/'A1,'/
CALL ERRSET(0)
C SUPPRESSES UNWANTED ERR MESSAGES
LPAR=0
IPRN=0
QX=0.
MOT=0
RETRO=-1.
INVRT=-1
ICON=-1
LCNT=1
PARENS=0
JZ=1
CALL RNDINT
C INIT RAND NUM GENERATOR.
PR=0
IAMP=0
C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
T5=0
NINS=0
K=0
IDALL=-1
QTS=-1.
KB=0
NWZ=1
BNW(1)=0
I=1
KL=0
TP=0
KN=IBLA
RA=0
CHN=0
DO 127 K=1,77,3
127 LIST(K)=0
C INITIALIZES MOTIVIC LIST FOR ERROR FINDING ROUTINE.
NWX=0
BY=-1
DO 1128 K=1,KZY
INVIS(K)=0
INST(K)=0
CNT(K)=0
RDEV(K)=0
C RDEV IS FOR RAND DEVIATIONS AT RUN TIME
NP(K)=0
IQ(K)=0
C IQ IS FOR RESTART FLAG
IPT(K,1)=0
DO 1128 L=1,32
1128 PCH(K,L)=0
ITYP=-1
C TYPE 'FILE NAME', TEMPO FACTOR(0=1), AMPL.FACT(0=1),
C SECONDS TO BE OMITTED, DUR AT CUTOFF.
JED=-1
2112 TYPE 8002
1112 ACCEPT 77732,INP
JFM(4)='5F)'
JFM(1)=' (A'
C FOR FREE 'A' FORMAT
CALL FMT(JFM,INP,MLX)
REREAD JFM,K,TF,AMPFAC,OP1,DURX
C JFM IS THE CURRENT FORMAT STATEMENT
IF(K.NE.'EDIT')GO TO 3112
JED=0
GO TO 2112
C 'E(DIT)' GOES TO EDIT MODE
3112 IF(TF.EQ.0)TF=1.
IF(AMPFAC.EQ.0)AMPFAC=1.
21122 IF(K.NE.'TYPE')GO TO 128
ITYP=0
DATA FINM/30H(' TYPE OUTPUT FILE NAME'/) /
IFLNM='FOR21'
CC*** 7/74 COLGATE TYPE FINM
C TO USE TYPE-IN MODE. FILE OF INPUT IS WRITTEN ON FOR21.DAT
CC** 7/74 COLGATE ACCEPT 1127,ISLAC
CC*** 7/74 COLGATE IF(ISLAC.EQ.IBLA)STOP
REWIND 21
CC** 7/74 COLGATE WRITE (21,1127) ISLAC
GO TO 3127
11122 FORMAT(1XA5,72A1)
128 IF(K.NE.'INFO')GO TO 3128
TYPE 8002
TYPE 1113
TYPE 118
TYPE 1114
TYPE 8002
GO TO 1112
118 FORMAT(' TO DSK=1, TTY=2, BOTH=0, LPT=22, PROOF=3, DEBUG=4'/)
CC*** TEMPORARY ***8002 FORMAT(' TYPE FILE NAME'/)
8002 FORMAT(' **** NEW VERSION ****',//' TYPE FILE NAME-- '$)
8001 FORMAT(A5,5F)
107 FORMAT(I,A5,5F)
1113 FORMAT(' NAME, TF, AMPFAC, OMIT", DUR".'/)
1114 FORMAT(' N1, N2=RAN NUM, N3=0 LISTS INPUT, N4=SINGLE INST.'/
1 ' IF -- N1=3 DURS ONLY, =4 V ARRAY'/
1 3X' 27 INSTRUMENTS ARE AVAILABLE'/)
1127 FORMAT(A5,72A1)
3128 IF(K.NE.IBLA)IFLNM=K
CALL IFILE(1,IFLNM)
CC*** 7/74 COLGATE READ(1,107)LN,ISLAC
READ(1,107)LN,IXIN
C CHECK FOR LINE NUMBERS ONLY.
REWIND 1
CALL IFILE(1,IFLNM)
CC*** 7/74 REREAD 77732,JNP
C FOR LATER USE
CC** 7/74 IF(LN.NE.0)GO TO 3127
C JUMP IF THE FILE HAS LINE NUMBERS.
CC*** 7/74 REREAD 1127,ISLAC
C REREADS FIRST LINE
3127 ISLAC=(IFLNM.AND."003777777777).OR."550000000000
C MAGIC TO CHANGE LFT. LETTER TO Z(INP. ABCDE BECOMES ZBCDE.DAT)
5127 TYPE 118
IF(DURX.EQ.0)DURX=19999.
IXIN=1
CC -- NOW AT TOP OF PAGE 4(2/74) DO 1107 K=1,30
CC1107 PL(K)=1.
INONLY=-1
ACCEPT 300,MX,X,Y,Z
IF(MX.NE.99)GO TO 6127
TYPE FINM
ACCEPT 1127,ISLAC
GO TO 5127
6127 IF(Z.NE.0)INONLY=Z
IF(X.NE.0)IXIN=X
C MX=3 GIVES DURS ONLY
C TO SUPPRESS LIST OF INPUT DATA, TYPE ANY 3RD NUM. (BUT 9.)
C (1 1 1 =RECORD,RAN. NUM=1,SUPPRESS INPUT.)
MZ=0
JOUT=5
C 5=OUTPUT TO TTY
SOS=-1.
IF(Y.NE.0)SOS=0
C IF 3RD NUM≠0, EDIT FILE WILL PRINT AS IT IS READ.
IF(MX.NE.22)GO TO 2107
JOUT=3
C DIRECT TO LPT AT COLGATE 6/74
CC JOUT=22
CC REWIND 22
2107 IF(MX.LE.1)MX=MX-2
IF(MX.EQ.-2.OR.MX.EQ.2.OR.MX.EQ.22)MZ=-1
IF(MX.EQ.4)MZ=-4
CC IF(SOS.AND.ITYP)WRITE(JOUT,87732)INP
CC*** 7/74 COLGATE IF(SOS.AND.ITYP)CALL COLTTY(JNP,JOUT,3)
C *************** READS INPUT ***********************
2308 IF(ITYP)GO TO 2127
DATA TINST /25H(' TYPE INST NAME, ETC'/)/
1,TEDIT/20H(' RETYPE LINE?'/ )/
23081 TYPE TINST
ACCEPT 77732,JNP
CC IF(JED)WRITE(21,77732)INP
IF(JED)CALL COLTTY(JNP,21,5)
JFM(4)='72A1)'
C PUTS ON LPT AND TTY
GO TO 1074
CC 6/74 COLGATE2127 JREAD=1
CC 6/74 COLGATE 4400 READ(1,77732,END=2337)JNP
2127 IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
CC SEE END OF PG.6 IF(SOS)WRITE(JOUT,87732)INP
CC 7/74 IF(SOS)CALL COLTTY(JNP,JOUT,3)
CC 6/74 COLGATE GO TO(441,442,443,444,445,446)JREAD
441 JFM(4)='72A1)'
IF(LN.EQ.0)GO TO 1074
REREAD 2114,LN,INP
C**** READS ONLY FILES WITH LINE NUMBERS!
JFM(1)=' (I,A'
CALL FMT(JFM,INP,MLX)
REREAD JFM,LN,J,INP
GO TO 4127
1074 JFM(1)=' (A'
CALL FMT(JFM,INP,MLX)
REREAD JFM,J,INP
4127 IF(JED.OR.K.EQ.'Y')GO TO 41271
C K CHECK IS TO PASS AFTER RETYPING
TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'Y')GO TO 23081
IF(K.EQ.'G')JED=-1
41271 IF(J.EQ.IBLA)GO TO 2308
MLX=1
IZ=0
JA=-1
ISUB=4
CALL CLEAN(INP,LEND)
C CLEANS OUT = AND , AND FINDS LINE LENGTH.
ALL=1.
VX1=0
VX2=0
VX3=0
LK=-1
K=0
IF(V(I-1).NE.-9900.-BY)GO TO 364
BY=-1.
I=I-1
364 DO 361 JD=1,LEND
N=INP(JD)
IF(N.NE.'R')GO TO 361
C LOOKS FOR 'RESTART'
DO 3611 M=JD,LEND
KL=INP(M)
IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI)GO TO 3631
CCZZZ IF(KL.EQ.IBLA.OR.KL.EQ.ISEMI.OR.KL.EQ.KSLA.OR.KL.EQ.',')GO TO 3631
3611 INP(M)=IBLA
C CHANGES 'RESTART' TO BLANKS
3631 DO 363 N=1,NINS
IF(J.NE.INST(N))GO TO 363
IQ(N)=-1
C SETS RESTART FLAG. THIS INST WILL NOW APPEAR WITH NEW NUM.
GO TO 362
363 CONTINUE
361 IF(N.EQ.ISEMI)GO TO 6773
6773 K=K+1
IF(K.GT.NINS)GO TO 36
IF(INST(K).NE.J.OR.IQ(K).EQ.-1)GO TO 6773
C FINDS CORRECT INST NUM. PASSES RESTARTED INSTS.
LK=K
GO TO 1773
36 IF(J.EQ.'RUN;'.OR.J.EQ.'RUN')GO TO 2337
IF(J.EQ.'INSER'.OR.J.EQ.'EDIT')ISUB=6
IF(J.EQ.ITMPO.OR.J.EQ.'CONDU'.OR.J.EQ.'PLAY'.OR.ISUB.GT.4)
1GO TO 1773
IF(J.EQ.'SECTI')GO TO 1081
C****************** ABOVE AND BELOW FOR 'SECTIONS'
IF(J.EQ.'END'.OR.J.EQ.'END S'.OR.J.EQ.'FINIS')GO TO 1082
362 LK=NINS+1
IF(LK.GT.KZY)GO TO 99
INST(LK)=J
IZ=LK
GO TO 1773
C*********** DOWN TO 99 FOR 'SECTIONS'
1083 V(I)=-99.
KL=1
GO TO 3083
C READS 'PLAY SECT. N1,N2'
1081 V(I)=-199.
KL=4
3083 DO 2081 K=KL,72
IF(INP(K).EQ.IBLA)GO TO 2081
IV(I+1)=INP(K)
I=I+2
3081 BY=-1.
GO TO 2308
2081 CONTINUE
C READS SECTION IDENTIFIER, -199. MARKS BEGINNING
C1082 IF(V(I-1).EQ.-9900.-BY)I=I-1
C********* FEB 15,71
1082 V(I)=-299.
I=I+1
GO TO 3081
C MARKS END OF SECTION
C************************
99 TYPE 199,LN
STOP
199 FORMAT(' ERROR!! LAST LINE READ =',I6/)
4 IF(LK.LE.NINS)GO TO 8773
IF(ALL.GT.0)GO TO 1004
IF(IDALL.GT.0)GO TO 8773
BG(LK)=VX1
IDALL=LK
GO TO 2004
C 'MOVE' CHANGES IN 'ALINS' CAN'T BE RESET IN INDIV. INSTS.
1004 BG(LK)=VX1
IF(LK.EQ.IZ)VX1=0
C MAY 3,71 **** ALL PARAMS WILL BE SET UP AT TIME 0.
C CHECK EFFECT ON 'MOVE'!
C ******** APR.23, 1971 FIXES BG TIMES IN 'MOVE'?????!!!!!!!
2004 NINS=LK
IF(VX3.NE.0)VX2=10000.+VX3
IF(VX2.EQ.0)VX2=-1
DUR(LK)=VX2
GO TO 900
C******** ABOVE FOR REST ONLY ENTRIES. FEB 18,71
8773 IF(VX2.NE.0)VX1=VX1*10000.+VX2
900 IF(VX1.EQ.BY.AND.J.NE.'PLAY')GO TO 5773
C*********** 'PLAY' IS FOR 'SECTIONS'
BY=VX1
C BY=CURRENT BG TIME.
V(I)=-9900.-BY
I=I+1
IF(NWZ.NE.0)CALL BGSORT(BY)
5773 IF(J.EQ.'TEMPO')GO TO 1106
IF(J.EQ.'CONDU')GO TO 3018
IF(J.EQ.'PLAY')GO TO 1083
C*********** ABOVE FOR 'SECTIONS'
4773 NW=LPAR
IF(I.GT.1900.)TYPE 107,I
ALL=1.
DF=0
ISUB=1
CCZZZ1299 IF(JZ.NE.0)GO TO 1773
1299 IF(JZ.NE.0)GO TO 2773
7773 IF(ITYP)GO TO 77731
DATA TPALN /20H(' TYPE A LINE'/) /
77734 TYPE TPALN
ACCEPT 77732,JNP
CC IF(JED)WRITE(21,77732) INP
IF(JED)CALL COLTTY(JNP,21,5)
IF(INP1.EQ.IBLA)GO TO 77734
GO TO 77733
77732 FORMAT(80A1)
CC87732 FORMAT(1X80A1)
CC 6/74 COLGATE 77731 JREAD=2
CC 6/74 COLGATE GO TO 4400
77731 IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
442 IF(LN.NE.0)REREAD 2114,LN,INP
IF(INP1.EQ.IBLA)GO TO 77731
IF(JED)GO TO 77733
TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'Y')GO TO 77734
IF(K.EQ.'G')JED=-1
C DOESN'T WORK FOR EDITS AND INSERTS YET???
77733 IF(ICON)MLX=1
ICON=-1
C FOR CONTINUATION LINES.
C 'LISTS' MUST END WITH ; IN NEW(7/74) VERSION.
2773 CALL CLEAN(INP,LEND)
1773 IF(IPRN.EQ.0)GO TO 17732
L=I-1
IF(QTS.AND.V(I-1).EQ.999.)L=L-1
IPRN=IPRN-1
IF(PARENS.EQ.0)GO TO 17733
PARENS=0
LIST(LCNT+2)=L
LCNT=LCNT+3
IF(IPRN.EQ.0)GO TO 17732
IPRN=0
17733 LIST(MOT)=L
MOT=0
C FOR ERROR TRAP
17732 JZ=0
N=0
17731 ML=MLX
C BIG LOOP -- TO END OF PAGE 1.
JD=ML
975 N=INP(JD)
IF(N.EQ.IBLA)GO TO 236
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 236
C ((((())))) MAY 13,71 /Z (D4/E/X 2 3)/ CS/ ETC. CAN USE 26 LABELS.
33611 IF(N.NE.'('.AND.N.NE.')')GO TO 2361
INP(JD)=IBLA
L=JD-1
5113 IF(INP(L).NE.IBLA)GO TO 2113
L=L-1
GO TO 5113
2113 IF(N.EQ.')')GO TO 3361
IF(PARENS.EQ.0)GO TO 1140
LCNT=LCNT+3
IF(MOT.NE.0)GO TO 11403
MOT=LCNT-1
1140 DO 11401 JC=1,LCNT-1,3
IF(INP(L).NE.LIST(JC))GO TO 11401
C FINDS DUPLICATE IDENTIFIER
TYPE 11402,INP(L)
GO TO 99
11403 TYPE 11404
GO TO 99
11404 FORMAT(' MORE THAN 2 PARENS OPEN'/)
11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
11401 CONTINUE
LIST(LCNT)=INP(L)
PARENS=-1.
INP(L)=IBLA
LIST(LCNT+1)=I
GO TO 236
C ''''''' FOR SINGLE QUOTES
3361 IPRN=IPRN+1
GO TO 236
C JUMPS BACK INTO QUOTE SECTION
CQ IF(PARENS.EQ.0)GO TO 2140
CQ LIST(LCNT+2)=L
CQ LCNT=LCNT+3
CQ PARENS=0
CQ GO TO 33612
CQ2140 LIST(MOT)=L
CQ GO TO 33612
CQC ))))))))))) LAST ) CAN'T APPEAR AT END OF LINE!!
C @@@@@@@@@@@@ /@Z/DS3/ ETC.
2361 IF(N.NE.'@')GO TO 5361
DO 113 L=1,LEND
K=JD+L
C K IS USED AT 240!!!
JG=INP(K)
IF(JG.NE.'-')GO TO 6113
RETRO=0
INP(K)=IBLA
GO TO 113
6113 IF(JG.NE.'$')GO TO 7113
C '$' IS FOR INVERSIONS IN 'NOTES'
INVRT=0
GO TO 113
7113 IF(JG.NE.IBLA)GO TO 4113
113 CONTINUE
4113 DO 6361 L=1,LCNT,3
IF(JG.NE.LIST(L))GO TO 6361
VX1=0
DO 40 M=JD+2,LEND
JG=INP(M)
IF(JG.EQ.IBLA)GO TO 40
CCZZZ IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI.OR.JG.EQ.'*')GO TO 140
IF(JG.EQ.KSLA.OR.JG.EQ.ISEMI)GO TO 140
ML=M
GO TO 240
40 CONTINUE
240 JC=JA
JA=-1
INP(K)=IBLA
CALL SCANR
JA=JC
140 JC=1
KN=LIST(L+1)
M=LIST(L+2)+1
IF(RETRO)GO TO 640
JC=M-1
M=KN-1
KN=JC
JC=-1
RETRO=-1.
640 IF(INVRT)GO TO 940
840 X=V(KN)
V(I)=X+VX1
C FINDS CENTER FOR INVERSION (+TRANSP.)
I=I+1
KN=KN+JC
IF(V(KN-JC).NE.85.)GO TO 940
V(I-1)=85.
GO TO 840
940 Z=V(KN)
IF(INVRT.EQ.0)GO TO 440
IF(VX1.EQ.0)GO TO 540
C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
IF(CODE.EQ.-33.)GO TO 440
V(I)=Z*VX1
GO TO 7361
440 IF(Z.EQ.85.)GO TO 540
Y=0
IF(INVRT.EQ.0)Y=(X-Z)*2.
V(I)=Z+VX1+Y
GO TO 7361
540 V(I)=Z
7361 I=I+1
KN=KN+JC
IF(KN.NE.M)GO TO 940
INVRT=-1
RB=V(I-1)
DO 8361 L=JD,LEND
JG=INP(L)
C PUT IN NOV 25, 72
CCZZZ IF(JG.EQ.ISEMI)GO TO 93612
KN=L
INP(L)=IBLA
IF(JG.EQ.KSLA)GO TO 9361
IF(JG.EQ.')')IPRN=IPRN+1
CCZZZ8361 IF(JG.EQ.'*')IAMP=-1
8361 IF(JG.EQ.ISEMI)IAMP=-1
GO TO 93612
9361 MLX=L
C FIX THIS & =IBLA BY CHNGING DO LOOP TO 'GO TO' AT 6721,2722
IF(IAMP.EQ.0.AND.QTS)GO TO 1773
C GO BACK IF NOT END OF LINE
JZ=-1
93612 IF(IAMP.EQ.0)GO TO 93611
C NOV 25, 72
IF(QTS)GO TO 3013
GO TO 2722
C THESE ARE FOR "LIT" ITEMS
C ******* DO NOT USE '@-' OR '@$' WITH 'LIT', RLIST OR RNOT****
C NO $ WITH FUNC. $ WITH NUMS AND RHY CAN GIVE NEG RESULT -- TRY IT!
CCZZZ93611 IF(JG.EQ.ISEMI)GO TO 7773
93611 IF(KN.EQ.LEND)GO TO 7773
JZ=0
IF(IPRN.NE.0)GO TO 1773
C ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑PICKS UP ' @X)/ ' SITUATION. 22/6/73
GO TO 236
C LAST TIME FOR QUOTES
C********↑↑ ↑↑ WAS TO 6017 JUNE 10,71
C JUMPS TO END STRING OF QUOTES
6361 CONTINUE
GO TO 99
C @@@@@@@@@@@@@@@@@@@@@@@@@@
5361 IF(N.EQ.'$')GO TO 99
C FOUND $ BUT NO @!
IF(N.NE.ID.OR.ISUB.NE.1)GO TO 53611
IF(INP(JD+1).NE.IF)GO TO 236
C JUMP IF NOT DUTY FACTOR
DF=DF-100.
GO TO 43615
53611 IF(N.NE.ISS.OR.INP(JD+1).NE.'U')GO TO 53612
DF=DF-200
C FOR SUBROUTINE FLAG. CAN'T CALL SUBR AT SAME TIME AS REP OR X!!!!
GO TO 43615
53612 IF(N.NE.IAA)GO TO 43611
C FINDS 'ALL'.
IF(INP(JD+1).NE.'L')GO TO 236
ALL=-1.
GO TO 43615
C TYPE 'ALL' AFTER PARAM NUM TO PUT DATA IN ALL INSTS.
C QUAD CALL MUST BE IN 1ST OF 5 PARAMS. QUAD MUST BE FOLLOWED
C BY SPC, / OR ;. OTHER CALLS SUCH AS MOVE,NUM ETC. CAN
C APPEAR BEFORE / OR ;, BUT "ALL" MUST! APPEAR
C BEFORE! QUAD (IF USED).
C ADD AN "F" TO QUAD FOR FUNCTIONS, AN "X" FOR X,Y COORDS.
C BASIC QUAD PRODUCES CIRCLES. /DEGS/RADIUS/CENT. X/CENT. Y/
C QUADX -- /X /Y / (5TH PARAM WILL ALWAYS BE WASTED)
43611 IF(N.NE.'Q'.OR.INP(JD+1).NE.'U')GO TO 4361
QX=-13.
DO 43612 N=JD,LEND
J=INP(N)
IF(J.EQ.IXX)QX=QX-1.
IF(J.EQ.IF)QX=QX-2.
IF(J.EQ.IBLA.OR.J.EQ.KSLA)GO TO 236
CCZZZ IF(J.EQ.IBLA.OR.J.EQ.KSLA.OR.J.EQ.ISEMI.OR.J.EQ.',')GO TO 236
43612 INP(N)=IBLA
4361 IF(N.NE.'I')GO TO 43613
IF(ISUB.NE.4)GO TO 43613
C NEXT MAKES INST NAME, P1 AND P2 INVISIBLE (REPLACES SEG, ETC.)
INVIS(LK)=-1
43615 DO 43614 L=JD,LEND
N=INP(L)
IF(N.EQ.IBLA.OR.N.EQ.KSLA)GO TO 236
CCZZZ IF(N.EQ.IBLA.OR.N.EQ.','.OR.N.EQ.ISEMI.OR.N.EQ.KSLA)GO TO 236
43614 INP(L)=IBLA
43613 IF(N.NE.KSLA)GO TO 636
MLX=JD+1
JZ=-1
IF(JD.GE.LEND-1)JZ=0
C SO IT WILL READ NEXT LINE.
INP(JD)=ISEMI
GO TO 336
CCZZZ436 IF(INP(MLX).NE.IBLA)GO TO 336
CCZZZ MLX=MLX+1
CCZZZ GO TO 436
636 IF(JD.LT.LEND)GO TO 1336
ICON=0
GO TO 77731
C TO CONTINUE ON NEXT LINE.
CCZZZ636 IF(N.NE.ISEMI)GO TO 936
1336 IF(N.NE.ISEMI)GO TO 936
IAMP=-1
336 IF(ISUB.EQ.104)GO TO 104
IF(ISUB.GT.3)GO TO 1899
GO TO (101,102,103),ISUB
C PAR MOV LIST OTHERS
CCZZZ936 IF(N.NE.IDOT)GO TO 736
936 IF(N.NE.IDOT)GO TO 136
L=INP(JD+1)
DO 836 KL=1,10
836 IF(L.EQ.IDAT(KL))GO TO 236
IF(CODE.EQ.-22.)INP(JD)=1
GO TO 236
C CHANGES DOTTED RHYTHMS TO '1'S.
CCZZZ736 IF(N.NE.'*')GO TO 136
CCZZZ IAMP=-1
CCZZZ INP(JD)=IBLA
CCZZZ GO TO 336
136 IF(N.NE.IQT)GO TO 236
DO 1361 K=JD+1,LEND
IF(INP(K).NE.IQT)GO TO 1361
JD=K+1
GO TO 975
C SKIPS MATERIAL IN QUOTES
1361 CONTINUE
GO TO 99
C OPEN QUOTES
236 JD=JD+1
IF(JD.LE.LEND)GO TO 975
TYPE 1236
GO TO 99
1236 FORMAT(' MISSING SEMICOLON')
1899 CALL SCANR
GO TO(1,2,3,4,5,6),ISUB
101 N=INP(ML)
IZ=ML
ML=ML+1
IF(N.EQ.IBLA)GO TO 101
C ⊗⊗⊗⊗⊗ MAY 13,71 @@@@@@@@@@
JA=-1
IF(N.EQ.IPP)GO TO 1
IF(N.EQ.IE)GO TO 2308
IF(N.EQ.'R')GO TO 2337
C 'RUN' MAY REPLACE 'END' FOR LAST INST.
IF(N.EQ.ID)GO TO 7720
GO TO 99
1 CALL SCANR
LPAR=VX1
IJ=LPAR
IF(QX.GE.0)GO TO 5703
IJ=LPAR+4
C SETS UP PARAM FOR QUAD CALL
V(I)=IJ+LK*10000
V(I+1)=2*ALL
C TEST "ALL" FEATURE HERE!!!!!!!
C X=-13(DEGREES),=-14(X,Y),=-15(CIRCLE FUNCTS),=-16(LINE FUNCTS)
V(I+2)=QX
I=I+3
QX=0.
5703 IAMP=0
IF(IJ.GT.NP(LK).AND.IJ.LT.31)NP(LK)=IJ
IF(LPAR.EQ.32)LPAR=1
V(I)=LPAR+LK*10000
C +1=WDCNT, +2=CODE, +3='NM' CCCCC
IJ=I+1
I=I+4
ITMP=0
CODE=0
NFLG=1
ML=IZ+M
C RE=REP R=RHY L=LIT M=MOVE MX=MOVX N=NOTES NU=NUM
C S--L=SUBL S--N=SUBN T=TAP RT=RTAP RL=RLIST RN=RNOTES
C QU=QUADC QUX=QUADX
5702 ML=ML+1
IF(ML.GT.72)GO TO 99
N=INP(ML)
IF(N.EQ.IBLA.OR.N.EQ.',')GO TO 5702
NL=INP(ML+1)
JA=-1
ISUB=0
IF(N.EQ.IXX)GO TO 2703
IF(N.EQ.'R')GO TO 6702
IF(N.EQ.IF)GO TO 8702
4005 JA=0
IF(N.EQ.IEN)GO TO 6005
IF(N.EQ.'M')GO TO 703
IF(N.EQ.'L')GO TO 2720
IF(N.EQ.ISS)GO TO 6703
IF(N.EQ.ITT)GO TO 4018
IF(N.EQ.IQT)GO TO 5720
IF(N.EQ.ISEMI)GO TO 2018
IF(N.EQ.IPP)JA=-1
C FOR /P5 P3/
CALL SCANR
IF(ISUB.EQ.8)GO TO 8
I=I+JJ
V(IJ+1)=NNUM+DF
IF(JJ.EQ.1)GO TO 4006
C IF NNUM IS '-2' THEN NOTES ARE PRINTED
IF(NNUM.NE.-2)GO TO 5006
IX=IJ+3
DO 2006 K=2,JJ,3
2006 CALL RANR(VX,K)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5006 IX=IJ+2
DO 6006 K=1,JJ
6006 V(IX+K)=VX(K)
V(IX+JJ-2)=1.
C ABOVE ENSURES THAT LAST RAND. UNIT REACHES 100% - 5/74 *********
GO TO 3013
4006 IF(JA)VX1=VX1/100.+9999.
C CHANGES /P5 P3/ TO /P5 9999.03/ ***** CHECK OUT ON OTHER MACHINES!
V(I-1)=VX1
GO TO 3013
6702 IF(NL.EQ.IE)GO TO 2703
C JUMP IF "REP"
IF(NL.EQ.ITT)GO TO 4018
C JUMP IF "RTAP"
CODE=-22
IF(NL.EQ.'L')CODE=-46.0
C JUMP IF "RLIST" (LIST OF RAND SELECTIONS)
IF(NL.NE.IEN)GO TO 1016
C JUMP IF NOT "RNOTES"
JA=0
C FOR SCANR
CODE=-36.
GO TO 1016
6005 CODE=-33
IF(NL.NE.'U')GO TO 1016
CODE=-44.
1610 JA=-1
GO TO 1016
8702 CODE=-35
IF(NL.EQ.'U')GO TO 1016
ML=ML+1
CALL SCANR
7 V(IJ+1)=CODE+DF
V(IJ+2)=1.
IF(VX1.GT.15)GO TO 99
C TRAPS F NUMS >15.
V(I)=VX1+85.
GO TO 7703
C******** MOVE IS NEXT ***********
703 BW=V(IJ-2)
IC=0
DO 7031 K=ML+1,72
IF(INP(K).EQ.ISEMI)GO TO 8031
7031 IF(INP(K).EQ.IXX)IC=-1
C IC=-1 IS FOR MOVX
8031 I=I-1
V(I)=0
X=-9900.-BY
IF(BY.EQ.0)X=-9900.-BG(LK)
IF(BW.EQ.X)GO TO 8005
IF(BW.NE.-9900.-BY)GO TO 1102
V(IJ-2)=X
GO TO 8005
1102 V(IJ)=V(IJ-1)
V(IJ-1)=X
IJ=IJ+1
I=I+1
8005 LP=IJ-1
BW=-9900.-X
ISUB=2
IZ=-1
C ABOVE ARRANGES NECESSARY BG TIME HEADINGS.
4703 GO TO 1299
102 IF(IZ.LT.0)GO TO 2102
C SKIPS NEXT FIRST TIME
BW=V(ICT)+BW
V(I)=-9900.-BW
V(I+1)=V(LP)
V(I+2)=(JJ+2)*ALL
V(I+3)=CODE+DF
I=I+4
IZ=1
2102 IF(BW.LT.10000.)CALL BGSORT(BW)
C ROUND-OFF NONSENSE
2 VX3=-9900.
VX2=VX3
CALL SCANR
IF(JJ.GT.0)GO TO 5102
JJ=ILIT
C SLASH WILL REPEAT MOVE INPUT -- 6/74
DO 6102 K=1,JJ
6102 VX(K)=VX(K+20)
GO TO 5005
C::::::::::::::: PUT THIS, AND AT 5505, IN SCOR5 ALSO ::::::::::::::
5102 IF(JJ.EQ.4)GO TO 99
C ERROR -- 4 ITEMS IN MOVE IMPOSSIBLE
IF(VX3.NE.-9900.)GO TO 3102
IF(VX2.NE.-9900.)GO TO 4102
VX2=VX1
VX1=10000.
4102 VX3=VX2
JJ=3
C 1,2 OR 3 NUMS CAN BE USED IN NON-RAN MOVES.
3102 IF(IZ.GE.0)GO TO 3006
V(IJ)=(JJ+2)*ALL
C WORD COUNT
CODE=-55.
IF(JJ.NE.3)CODE=-57.
IF(NFLG)CODE=CODE-1.
IF(IC)CODE=-59.
C CODE=-56 OR -58 FOR NOTES.
V(IJ+1)=CODE+DF
IZ=0
3006 IF(NFLG.EQ.1)GO TO 5005
CALL RANR(VX,2)
IF(JJ.NE.3)CALL RANR(VX,4)
C FOR RAN. SELEC. OF NOTES. FINDS HIGHEST NOTE.
5005 ICT=I
ILIT=JJ
C SAVES FOR SLASH REPEAT FEATURE
IJ=IJ+1
DO 1006 K=1,JJ
VX(20+K)=VX(K)
C SAVES FOR SLASH REPEAT FEATURE
1006 V(IJ+K)=VX(K)
I=I+JJ
IJ=I+2
IF(IAMP.EQ.0)GO TO 1299
C*************** MAY 18,71 ***** ALWAYS RESETS TO TIME 0 WHEN MOVE IS USED.
V(I)=-9900.-BY
GO TO 8703
7703 V(IJ)=4.*ALL
8703 I=I+1
GO TO 4773
C FOR SUBROUTINES, -12=NUMS. -11=LETTERS.
6703 CODE=-12.
IF(INP(ML+3).EQ.'L')CODE=-11.
V(IJ)=2.*ALL
V(IJ+1)=CODE+DF
I=I-1
GO TO 4773
4018 CNT(LK)=-9900.-BY
P(LK)=V(I-4)
CC 6/74 COLGATE JREAD=3
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
443 IF(LN.NE.0)REREAD 107,K,IPT(LK,1)
IF(LN.EQ.0)REREAD 8001,IPT(LK,1)
C NAME OF RHYTHM FILE. (ONLY ONE PER INST.) READS DATA JUST BEFORE RUN
IF(NL.NE.ITT)GO TO 2338
CODE=-23.
GO TO 1016
2338 I=I-4
GO TO 4773
3018 CNT(KZY)=-9900.
CC JREAD=4
CC COLGATE 6/74 GO TO 4400
IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
444 IF(LN.NE.0)REREAD 107,K,IPT(KZY,1)
IF(LN.EQ.0)REREAD 8001,IPT(KZY,1)
P(KZY)=980000.
GO TO 2308
C CAN'T USE 'TAP' OR 'RTAP' WITH INST KZY IF USING 'CONDUCT'.
C 'REP'
2703 ML=ML+1
VX1=0
VX2=0
VX3=0
IF(N.EQ.IXX)GO TO 2704
INP(ML)=IBLA
INP(ML+1)=IBLA
C WIPES OUT 'EP' IN 'REP'
2704 CALL SCANR
V(IJ)=3.
V(IJ+1)=-66.0
IF(VX1.EQ.32.)VX1=1.
IF(VX1.EQ.0)VX1=LPAR
IF(VX2.EQ.0)VX2=LK-1
V(IJ+2)=VX1+VX2*10000.
KL=VX2
IF(DUR(LK).LT.0)DUR(LK)=DUR(KL)
IF(VX3.EQ.0)GO TO 4773
L=VX3
ML=LK+1
DO 1018 KL=ML,L
IF(LPAR.GT.NP(KL).AND.LPAR.LT.31)NP(KL)=LPAR
IF(DUR(KL))DUR(KL)=DUR(LK)
C TO SET DUR WHEN DUPLICATING NOTES THAT END WITH 'END;;'
V(I)=V(I-4)+10000.
V(I+1)=3.
V(I+2)=-66.
V(I+3)=V(I-1)
1018 I=I+4
GO TO 4773
2018 IF(DF.EQ.0)GO TO 20181
C NEXT FOR Pn SUBR/ I.E. NOTHING BUT P AND SUB CALL. 7/73
V(IJ+1)=-201.
V(IJ+2)=1.
V(IJ+3)=0
GO TO 7703
20181 V(IJ)=3.
V(IJ+1)=-66.
V(IJ+2)=NW+LK*10000
GO TO 4773
C READS /P5 .3 "ABC" .7 "XYZ"/
8 V(IJ+1)=-77.+DF
C DF HAS SUBR CALL INFO
I=I+1
VX(JJ-1)=1
C FOR RAND. SINGLE LITS.
DO 3722 K=1,JJ,2
V(I)=VX(K)
3722 I=I+1
V(IJ+2)=JJ/2
V(IJ+3)=I
DO 4722 K=2,JJ,2
KN=I
I=I+1
L=VX(K)
DO 6722 KL=L,72
IF(INP(KL).EQ.IQT)GO TO 4722
IV(I)=INP(KL)
6722 I=I+1
4722 V(KN)=I-KN-1
V(IJ)=(I-IJ)*ALL
GO TO 4773
2720 QTS=0
ISUB=104
GO TO 1299
104 DO 6721 K=ML,LEND
JC=K+1
IF(INP(K).EQ.IQT)GO TO 7721
6721 IF(INP(K).EQ.KSLA.OR.INP(K).EQ.ISEMI)GO TO 7232
C FOR REPEAT OF ITEM BY SLASH
CC7232 DO 7231 K=I-1,1,-1
CC CHNGD 6/74 IF(ABS(V(K)).GT.72.)GO TO 7231
CC NL=V(K)
CC DO 7230 KL=K,K+NL
7232 DO 7230 KL=ILIT,ILIT+NLIT
V(I)=V(KL)
7230 I=I+1
GO TO 27222
7231 CONTINUE
5720 IAMP=-1
JC=ML+1
C FOR SINGLE 'LIT' ITEMS.
7721 DO 1722 KL=JC+1,LEND
IF(INP(KL).NE.IQT)GO TO 1722
JD=KL-1
ML=KL+1
NLIT=KL-JC
C EXTENT OF LIT ITEM IS FOUND
GO TO 8721
1722 CONTINUE
C CAN'T USE SLASH FOR REPEAT AFTER @Q
8721 V(I)=NLIT
ILIT=I
DO 9721 K=JC,JD
C PUTS ITEM IN "IV" ARRAY
I=I+1
9721 IV(I)=INP(K)
I=I+1
27222 IF(IAMP.EQ.0)GO TO 1299
2722 V(I)=999.
QTS=-1.
27221 V(IJ+1)=-88.+DF
V(IJ)=(I-IJ+1)*ALL
IJ=IJ+2
V(IJ)=IJ+1
I=I+1
ISUB=1
GO TO 1299
7720 V(I)=LK
V(I+1)=3.
V(I+2)=-67.
ML=ML+4
CALL SCANR
V(I+3)=VX1
I=I+4
L=VX1
IF(NP(LK).LT.NP(L))NP(LK)=NP(L)
IF(DUR(LK).LT.0)DUR(LK)=DUR(L)
GO TO 4773
C TYPE 'DUPL N;' N=INST # TO BE DUPLICATED.
142 FORMAT(I,15A5)
1301 FORMAT(15A5)
CCC2773 FORMAT(I,A5,72A1)
2114 FORMAT(I,72A1)
300 FORMAT(I,3F,A1)
301 FORMAT(3F,A1)
6 KB=KB+1
IF(JED.GT.0)JED=0
IF(J.EQ.'INSER')GO TO 1340
OTH(KB,1)=VX1*100000.+VX2*100.+VX3
GO TO 340
1340 X=VX1
IF(VX2.NE.0)X=1000000.+VX1*100000.+VX2
OTH(KB,1)=X
GO TO 1338
C ABOVE IS TO PUT INSERT AFTER NOTE # OF A PARTICULAR
C INSTRUMENT. FOR COMMENT AT START, SET BG TIME TO 1,1
C - BEGIN LINE WITH <,END WITH ;
C UP TO 75 CHARACTERS MAY BE TYPED.
340 IF(VX3.NE.2)GO TO 1338
IF(ITYP.GE.0)GO TO 449
CC JREAD=5
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
445 OTH(KB,3)=1.
IF(LN.EQ.0)GO TO 447
REREAD 300,K,OTH(KB,2)
GO TO 1447
447 REREAD 301,OTH(KB,2)
1447 IF(JED)GO TO 2308
3445 TYPE TEDIT
ACCEPT 77732,K
IF(K.EQ.'G')JED=-1
IF(J.EQ.'INSER')GO TO 3446
IF(K.NE.'Y'.OR.JED)GO TO 2308
449 TYPE TPALN
ACCEPT 301,OTH(KB,2)
IF(JED)WRITE(21,301) OTH(KB,2)
GO TO 2308
1338 IF(ITYP.GE.0)GO TO 1449
CC JREAD=6
CC 6/74 COLGATE GO TO 4400
IF(READER(JNP))GO TO 2337
C READS A LINE. IF END OF FILE, JUMPS.
446 IF(LN.EQ.0)GO TO 448
REREAD 142,K,(OTH(KB,JD),JD=2,16)
GO TO 1446
448 REREAD 1301,(OTH(KB,JD),JD=2,16)
1446 IF(JED)2446,3445,2446
3446 IF(K.NE.'Y'.OR.JED)GO TO 2446
1449 TYPE TPALN
ACCEPT 1301,(OTH(KB,JD),JD=2,16)
IF(JED)WRITE(21,1301)(OTH(KB,JD),JD=2,16)
2446 X=OTH(KB,2)
IF(J.EQ.'INSER'.AND.VX3.NE.0.AND.X.NE.'*')GO TO 6
IF(X.EQ.'*')KB=KB-1
C ALLOWS SEVERAL LINES OF 'INSERT' IF ANY 3RD #.
C LAST LINE HAS '*' IN COLUMN 1.
GO TO 2308
C IF NO PARAM NUM IS GIVEN, ALL PARAMS MUST BE TYPED.
C INSERT MAY INCLUDE 10 CHARS(P3-P30),
C P2, A # ONLY. IF MORE THAN 1 PARAM IS TO BE EDITED AND
C P2 IS ONE OF THEM, FIRST EDIT P2 TO DESIRED VALUE,
C CHANGE P2 TO MINUS = THEN INSERT ENTIRE NOTE TO PLAY
C JUST AFTER ORIGINAL NOTE(WHICH WILL BE A REST).
C BX=INST N. Y=NOTE N. Z=PARAM N.
1106 KTMP=1
TP=60.
IAMP=0
BW=BY
ITMP=-1
ISUB=5
JA=-1
GO TO 2016
3019 V(I)=990000.00
V(I+1)=4.
V(I+2)=VX1
V(I+3)=VX2/TP
V(I+4)=VX3/TP
I=I+5
BY=BW
C SEPT 18, 70
IF(VX1.EQ.0)GO TO 2308
BW=BW+VX1
V(I)=-9900.-BW
I=I+1
CALL BGSORT(BW)
9003 IF(IAMP)GO TO 4003
2016 VX3=0
VX2=0
GO TO 1299
5 IF(VX2.NE.0)GO TO 105
C 'TEMPO/120*;' OR 'TEMPO/1.5 72*;' IS OK.
VX2=VX1
VX1=0
105 IF(VX3.EQ.0)VX3=VX2
IF(VX2.LT.11.)TP=1.
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=VX1
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX3
C PCH(1)=TIME (2)=MM1 (3)=MM2
KTMP=KTMP+1
IF(IAMP.EQ.0)GO TO 2016
4003 VX1=0
IAMP=0
VX2=VX3
IF(J.EQ.ITMPO)GO TO 3019
PCH(1,KTMP)=0
PCH(2,KTMP)=VX2
PCH(3,KTMP)=VX2
C MM CAN BE FROM 11 UP ITMPO FACTOR FROM 10 DOWN.
C UP TO 30 ITMPO CHANGES MAY BE MADE.
1016 IA=I
IZ=1
3100 V(I-2)=CODE+DF
ISUB=3
5016 IF(IAMP.GE.0)GO TO 1299
117 IF(IZ-2)3013,9004,9004
103 K=INP(ML)
IF(K.EQ.ITT)GO TO 1106
IF(K.EQ.ISEMI)GO TO 1014
IF(K.NE.IBLA) GO TO 1899
ML=ML+1
GO TO 103
3 IF(VX1.EQ.-99.)GO TO 4022
IF(CODE.EQ.-22.)GO TO 2017
IF(CODE.LT.-23.OR.IZ/2*2.EQ.IZ)GO TO 17
C CHECKS PAIRS OF NUMBERS FOR 'RTAP'
2017 IF(VX1.EQ.10000.)GO TO 17
VX1=4./VX1
IF(JJ.NE.1)GO TO 2014
V(I)=VX1
GO TO 114
1217 IF(VX1.EQ.10000.)GO TO 114
C FOR "FINE" IN LIST
V(I+1)=VX2
IF(CODE.EQ.-36.)CALL RANR(V,I)
2217 I=I+1
C SETS UP STRING OF RAND SELECTIONS
GO TO 114
3217 V(I)=V(I-2)
V(I+1)=RB
C FOR SLASH REPTS OF RAND SELEC UNITS. ("REP" CAN'T BE USED!)
GO TO 2217
C******** PUT IN ERROR TRAP FOR "REP" ETC. ******
2014 DO 9006 L=2,JJ
IF(VX(L).EQ.0)GO TO 17
9006 VX1=4./VX(L)+VX1
JJ=1
17 V(I)=VX1
IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 1217
IF(CODE.EQ.-35.AND.VX1.GT.15)GO TO 99
C FINDS F NUM.>15!
C JUMP IF STRING OF RAND SELECS.
IF(JJ.EQ.1)GO TO 114
L=VX(JJ)-1
X=V(I)
NL=I+1
I=L+I
DO 1017 K=NL,I
1017 V(K)=X
C ADDS UP TOTAL OF NOTES IN SEQ.
IZ=IZ+L
GO TO 114
1014 IF(CODE.EQ.-46..OR.CODE.EQ.-36.)GO TO 3217
V(I)=RB
C RB SAVES IT FOR SLASH REPEAT
114 RB=V(I)
I=I+1
IZ=IZ+1
GO TO 5016
4022 JC=VX2+.3
JD=VX3-.5
IF(JJ.EQ.2)JD=1
C********* MAY 19,71 ----MANY LINES ABOVE.
IZ=IZ+JC*JD
C JC=HOW MANY TIMES, JD=HOW MANY NOTES
DO 1005 K=1,JD
NL=I+JC-1
DO 2005 L=I,NL
2005 V(L)=V(L-JC)
1005 I=I+JC
RB=V(NL)
C RB SAVES DATA FOR SLASH REPEAT FEATURE.
GO TO 5016
9004 IF(ITMP.EQ.0)GO TO 3013
C*********** JUNE 1,71
IZ=IZ-1
C***** JAN. 1974
KA=1
IC=1
K=0
J=1
Z=0
RC=0
9007 Y=PCH(3,IC)/TP
X=PCH(2,IC)/TP
Z=PCH(1,IC)
CALL SQYY(YY,X,Y,Z)
XT(1)=X
XA=RA
RD=1
RB=0
ZZ=Z
7020 RA=V(IA+K)
IF(RA.EQ.10000.)GO TO 3013
4020 RD=1
IF(RA.LT.0)RD=-1.
RA=RA*RD
IF(KA.EQ.0)RA=RA-RC
W=RA
RB=W
IF(W.LE.Z)GO TO 2020
IF(Z.NE.0)GO TO 3020
RA=RA/Y
RB=-1.
RC=0
GO TO 8020
3020 W=Z
RC=W+RC
GO TO 24
2020 RC=0
24 IF(X.NE.Y)GO TO 424
RA=W/X
GO TO 8020
C DUR OF TMP + BG TIME OF TMP - NOTE VALUE -
C BG TIME OF NOTE. CHN=TBG.
424 RAX=XT(J)
RA=(-2.*RAX+(4.*RAX**2+8.*YY*W)**.5)/(2.*YY)
XT(J)=RAX+YY*RA
8020 IF(KA.EQ.0)RA=RA+XA
KA=1
IF(RC.NE.0)GO TO 1011
IF(T5.EQ.1)GO TO 8203
V(IA+K)=RA*RD
IF(K.EQ.IZ)GO TO 3013
C*********** JUNE 1,71
1011 IF(T5.EQ.1)GO TO 2011
K=K+1
IF(ZZ.NE.0)Z=Z-W
IF((Z.GT.0).OR.(RB.EQ.-1.))GO TO 7020
IC=IC+1
IF(RB.EQ.W)GO TO 9007
KA=0
K=K-1
GO TO 9007
C********* MAY 13,71 OMITS REPEATED RHY. FEATURE.
C ML=I-1
3013 X=I-IJ
V(IJ+2)=X-3.
V(IJ)=X*ALL
IF(CODE.NE.-35)GO TO 4773
M=IJ+3
C SETS NUMBERS FOR FUNCS.
DO 313 K=M,I-1
313 IF(V(K).LT.85.)V(K)=V(K)+85.
GO TO 4773
2011 XA=RA
IF(K.GT.1)GO TO 9020
K=I-6
ZPAR=-9900.-CHN-ZZ
DO 3011 KL=8,I
IF((V(K).EQ.ZPAR).AND.(V(K+1).EQ.990000.))GO TO 9020
3011 K=K-1
9020 W=ZZ
IF(V(K+3))K=K+3
C ABOVE IS FOR TYPED IN TEMPO CHANGES
KA=K+3
ZZ=V(KA)
C DUR OF NEXT TEMPI
X=V(KA+1)
Y=V(KA+2)
213 KA=0
Z=ZZ
CALL SQYY(YY,X,Y,Z)
CHN=CHN+W
XT(J)=X
IF(KA.EQ.1)Z=0
RA=PR
KA=0
K=K+3
GO TO 4020
2337 T=0
DO 1107 K=1,30
1107 PL(K)=1.
C 2/74--WAS AT 17300/1 SETS DEFAULT OUTPUT MODE TO 1.
IF(ITYP)GO TO 23371
END FILE 21
DATA ENFI /25H(' INPUT ON FOR21.DAT '/)/
TYPE ENFI
C**** NOT THIS ***** PUTS AWAY TYPED IN DATA. TO REUSE, EDIT FOR21.DAT.
C PUTS AWAY TYPED IN DATA. TO REUSE, EDIT SCORX
23371 IF(SOS)WRITE(JOUT,902)
C WRITES A BLANK LINE
NWZZ=0
IAMP=0
IT3=0
K=1
IX=0
BG(NINS+1)=19999.
4011 IF(CNT(K))GO TO 5011
6011 IF(K.EQ.KZY)GO TO 4337
K=K+1
GO TO 4011
5011 L=V(I-1)/(-9900.)
IF(L.EQ.1)I=I-1
V(I)=CNT(K)
V(I+1)=P(K)
V(I+3)=-44.
I=I+5
IF(P(K).EQ.980000.)I=I-4
KL=I
REWIND 1
ICT=IPT(K,1)
CALL IFILE(1,ICT)
9011 L=I+6
READ(1,7011)(V(M),M=I,L)
C READS "CONDUCT" AND "RHYTHM" (TAP) DATA.
IF(V(L).EQ.999.)GO TO 8011
I=L+1
GO TO 9011
8011 IF(P(K).NE.980000.)GO TO 6337
DO 7337 K=L,I,-1
7337 IF(V(K).NE.999.)GO TO 8337
8337 I=K-1
V(I)=0
V(I+1)=V(K)
V(I+2)=V(K)
C K WAS I-1 ABOVE.
I=I+3
V(KL+1)=I-KL-1
C ABOVE RESETS WORDCOUNT FOR 'CONDUCT' DATA.
GO TO 4337
6337 DO 5337 M=I,L
KN=M
5337 IF(V(M).EQ.999.)GO TO 3337
3337 I=KN
KN=I-KL
V(KL-1)=KN
V(KL-3)=KN+3
GO TO 6011
7011 FORMAT(7F)
4337 IF(V(I-1).EQ.-9900.-BY)I=I-1
V(I)=-19899.
PP1=0
T6=10000.
DO 2118 K=1,NINS
ROFF(K)=0
C********* FEB 17,71
M=NP(K)
IT(K)=0
IPT(K,31)=0
NCNT(K,31)=1
DO 2118 L=1,M
NCNT(K,L)=1
2118 IPT(K,L)=0
DO 5013 K=1,IXIN
5013 X=RAND(0.0,0.0)
REWIND 1
IF(MX)CALL OFILE(1,ISLAC)
NW=1
NWX=0
TDUR=0
A=0
T2=1.
T4=1.
T5=0
J=1
MK=0
C IS THE ABOVE NEEDED?
IF(MX.NE.3)GO TO 40021
K=4
10023 N=AMOD(V(K),100.0)/-11.
C AMOD NEEDED BECAUSE CODE # MAY HAVE -100 FOR DF OR -200 FOR SUBR.
IF((N.NE.2.AND.N.NE.3.AND.N.NE.4).OR
1 .V(K-2).LT.10000.)GO TO 10021
J=V(K+1)
IF(J.EQ.1)GO TO 10024
IF(N.EQ.3.AND.V(K+J+1).EQ.101.)J=J-1
N=V(K-2)
L=N/10000
M=N-L*10000
TYPE 10022,INST(L),M,J
10024 K=K+ABS(V(K-1))
10021 K=K+1
IF(K.LT.I)GO TO 10023
40021 IF(MZ.NE.-4)GO TO 1002
N=1
40022 K=N+1
IF(N.GT.I)CALL EXIT
X=V(N)
IF(X.EQ.-199..OR.X.EQ.-99.)GO TO 40024
IF(X.GE.0)GO TO 40023
PRINT 4002,X
N=N+1
GO TO 40022
40024 J=N+1
GO TO 40025
C FOR 'SECTIONS'
40023 J=ABS(V(K))+K-1
40025 PRINT 4002,(V(K),K=N,J)
N=J+1
GO TO 40022
10022 FORMAT(1XA5,' P',I2,' HAS ',I3,' ITEMS.')
4002 FORMAT(10F12.3)
1002 IF(IDALL)GO TO 600
X=DUR(IDALL)
DO 2002 K=1,NINS
2002 IF(DUR(K))DUR(K)=X
C ***** SORTER *************************
C ******* OUTPUT LOOP FROM HERE ON ********
600 IL=0
C********** BELOW IS FOR 'SECTIONS'
KODE=0
NWX=NWX+1
MK=MK+1
Y=BNW(NW)
723 IL=IL+1
3723 Z=V(IL)
IF(Z.EQ.-19899.)GO TO 732
IF(Z.NE.-9900.-Y)GO TO 723
C********** BELOW IS FOR 'SECTIONS'
IF(V(IL-2).EQ.-199.)KODE=IV(IL-1)
2723 IL=IL+1
729 K=IL+2
MOT=V(IL+1)
RD=V(K)
IF(RD.EQ.-67.)GO TO 3726
RB=V(IL)
C************ DOWN TO 4150 IS FOR 'SECTIONS'
IF(RB.NE.-99.)GO TO 4150
KODE=IV(K-1)
2160 IF(KODE.EQ.0)GO TO 723
IF(MZ)WRITE(JOUT,9150),KODE
KL=Y/10000.
RB=Y+KL*10000.
DO 5150 KL=1,I
IF(V(KL).NE.-199..OR.IV(KL+1).NE.KODE)GO TO 5150
IV(K-1)=0
C WHEN 'PLAY' HAS BEEN FOUND, INDENTIFIER CHNGED TO 0
RD=V(KL+2)+9900.
DO 6150 L=KL+2,I
M=V(L)/(-9900.)
IF(M.NE.1)GO TO 6150
RA=RB+RD-V(L)-9900.
V(L)=-9900.-RA
C UPDATES BG TIMES INSIDE SECTION.
CALL BGSORT(RA)
C7150 IF(RA.EQ.BNW(KA))GO TO 6150
C UPDATES LIST OF CHANGE TIMES.
6150 IF(V(L).EQ.-299.)GO TO 160
5150 CONTINUE
160 IL=1
GO TO 3723
C*********** ABOVE IS FOR 'SECTION' REPEATS
4150 LK=RB/10000.+.2
IF(LK.GE.98)GO TO 7700
LP=RB-LK*10000
C LK=INST # LP=PARAM #
LN=IPT(LK,LP)
IPT(LK,LP)=IL+2
IF(RD.EQ.-66.)GO TO 726
IF(RD.EQ.-55..OR.RD.EQ.-56.)GO TO 1726
IF(RD.EQ.-23)GO TO 6700
2727 ML=IPT(LK,LP)
IF(MOT.GT.0)GO TO 3727
C USE NEG WDCNT FOR 'ALL'
DO 4727 KL=LK+1,NINS
IF(NP(KL).LT.LP.AND.LP.LT.31)NP(KL)=LP
IPT(KL,LP)=-(LK+(LP-1)*KZY)
NCNT(KL,LP)=10000
4727 IF(DUR(KL))DUR(KL)=1000.
C ASSUMES THAT DURATIONS ARE SET IN 'NOTES'.
C AFTER 'ALL' IS USED ONCE IT WORKS LIKE DUPL OR REP.
GO TO 727
C 'MOVE' WITH 'ALL' KEEPS ORIGINAL TIME DATA REGARDLESS OF BG TIMES.
3727 IF(V(IL).NE.V(LN-1).OR.LN.EQ.0)GO TO 727
DO 1727 L=1,NINS
DO 1727 KL=1,NP(L)
IF(LN.NE.IPT(L,KL))GO TO 1727
NCNT(L,KL)=10000
C ******* JAN 29,70
IPT(L,KL)=ML
C RESETS POINTERS FOR DUPL AND REP INSTS.
C *** 'ALL' WILL NOT WORK WITH RAN TF.!!!!!*******FEB 21,73
1727 CONTINUE
727 NCNT(LK,LP)=10000
C******** MAY 13,71 RHY REP. FEATURE OMITTED.
2150 IF(MOT)MOT=-MOT
IL=IL+MOT+1
3150 IF(V(IL))GO TO 3723
GO TO 729
726 RB=V(IL+3)
K=RB/10000.
L=RB-K*10000
IPT(LK,LP)=-(K+(L-1)*KZY)
GO TO 2727
3726 LK=V(IL)
M=V(K+1)
KL=NP(M)
DO 4726 L=1,KL
IPT(LK,L)=IPT(M,L)
IF(IPT(M,L).NE.0)NCNT(LK,L)=10000
C****** JUN 29 71 (LK,L) WAS (L,K)....???????
4726 CONTINUE
IPT(LK,31)=IPT(M,31)
K=0
GO TO 2150
C ABOVE IS FOR DUPLICATION ROUTINE NEXT ADJUSTS TIMES FOR 'RTAP'
6700 KL=IL+V(IL+1)+1.3
RC=V(K-2)
1770 IF(V(KL))GO TO 700
2700 KL=KL+V(KL+1)+1.3
GO TO 1770
700 KL=KL+1
IF(Z.NE.V(KL-1).OR.V(KL).NE.RC)GO TO 2700
KL=KL+3
KN=IL+3
LN=V(KN)+.3
DO 3700 L=1,LN,2
RA=V(L+KN)
KA=V(L+KN+1)+.3
RB=0
DO 4700 LP=1,KA
4700 RB=RB+V(KL+LP)
DO 5700 LP=1,KA
5700 V(KL+LP)=V(KL+LP)/RB*RA
V(KL+KA)=V(KL+KA)+.00030
3700 KL=KL+KA
GO TO 2150
C BELOW FOR 'TEMPO' SETUP
7700 T2=V(IL+4)
T1=V(IL+3)
TBG=Y
TDUR=V(IL+2)
CALL SQYY(AC,T1,T2,TDUR)
8700 IF(TDUR.EQ.0)TDUR=10000.
T5=1.
T6=TBG+TDUR
IT3=1.
IF(LK.EQ.98)IT3=IL+2
T4=1.
GO TO 2150
C*************** ANY WDCNTS DOWN FROM HERE. *********
C NEXT ADJUSTS 'MOVE' TIMES IF BG IS AT A NOTE NUMBER.
1726 IF(V(IL-1).GT.-19000.)GO TO 2727
RA=BT
K=IL-1
2726 V(K)=-9900.-RA
ISUB=-1
L=K+5
RB=V(L)+V(L-1)
V(L-1)=RA
K=K+V(K+2)+2
IF(V(K).GT.-19000..OR.V(K+1).NE.V(IL).OR.
1 V(K).NE.-9900.-RB)GO TO 2727
RA=RA+V(L)
CALL BGSORT(RA)
GO TO 2726
C CONVERTS BG TIME OF NOTE NUM TO REAL TIME. DOESN'T WORK WITH -66!
C NOW WE BEGIN ON!! NOTE NUM. NOT AFTER NOTE NUM.
732 DO 2606 K=NW,NWZ
2606 BNW(K)=BNW(K+1)
NWZ=NWZ-1
IF(NWZ.EQ.0)GO TO 2111
IF(NWZZ.EQ.1)GO TO 5111
NWZZ=1
IF(NWZ.EQ.1)GO TO 1111
DO 3111 K=1,NWZ
IF(BNW(K).LT.1000.)GO TO 3111
X=BNW(NWZZ)
BNW(NWZZ)=BNW(K)
BNW(K)=X
NWZZ=NWZZ+1
3111 CONTINUE
5111 IF(NWZZ.EQ.NWZ)GO TO 1111
L=NWZZ+1
X=BNW(NWZZ)
DO 4111 K=L,NWZ
IF(BNW(K).GT.X)GO TO 4111
RA=BNW(K)
BNW(K)=X
X=RA
4111 CONTINUE
BNW(NWZZ)=X
GO TO 1111
111 FORMAT(1XA5,'.DAT',12X,'EDIT FILE NAME=',A5,8X,
1'V ARRAY=',I4,'/2000',/' TEMPO FACTOR=',F6.2,4X,
1'RANDOM NUMBER =',I6/)
1023 FORMAT(/' < ',A5,'.DAT '/1XA5)
C********** BELOW IS FOR 'SECTIONS'
9150 FORMAT(/3X'******* SECTION ',A1)
2111 NWZ=-1
C ABOVE ORDERS BNW DATA TO SAVE TIME AT 1108 ON PG5.
1111 IF(MZ.EQ.0)GO TO 1601
IF(NWX.NE.1)GO TO 1486
WRITE(JOUT,111)ISLAC,IFLNM,I,TF,IXIN
C*********** JUNE 1,71
C********** BELOW IS FOR 'SECTIONS'
1486 IF(KODE.NE.0)WRITE(JOUT,9150),KODE
K=NWX-1
C*********** JUNE 1,71
IF(NWX.GT.1.AND.IT(J).NE.-3)WRITE(JOUT,3154),K,Y
IF(IT(J).EQ.-3)WRITE(JOUT,5154),K,BX,INST(J)
C*********** JUNE 1,71 X 3 K'S
DO 602 K=1,NINS
48 LK=INST(K)
C*********** JUNE 1,71
IF(NCNT(K,31).NE.10000.AND.NWX.GT.1)GO TO 602
NCNT(K,31)=1
IJ=IPT(K,31)
X=0
IF(IJ.NE.0)X=V(IJ+2)
WRITE(JOUT,5396),LK,X
X=DUR(K)
IF(X.GT.10000.)GO TO 83
WRITE(JOUT,8396),X
GO TO 602
5396 FORMAT(5XA5,' RANDOM TF =',F4.2,10X,'DURATION =',$)
7396 FORMAT('+',F5.0,' NOTES')
8396 FORMAT('+',F6.2,'"')
83 X=X-10000.
WRITE(JOUT,7396),X
602 CONTINUE
715 IF(IT3.NE.1.)GO TO 1602
RA=T1*TP
RB=T2*TP
WRITE(JOUT,6154),RA,RB,TDUR
IT3=0
1602 IF(NWX.EQ.1)GO TO 315
IF(IT(J).EQ.-3)GO TO 1108
C*********** JUNE 1,71
6154 FORMAT(' TMP=',F7.3,' TO',F8.3,' DURING',F6.2,' SECS.'/)
7154 FORMAT(' ''CONDUCT'' FILE NAME = ',A5/)
5154 FORMAT(/' << CHANGE',I3,' BEGINS ON NOTE',F5.0,1XA5,' >>'/)
902 FORMAT(1XA5/)
3154 FORMAT(/' << BASIC TIME OF CHANGE',I3,' IS',F8.3,'" >>'/)
4154 FORMAT(' THE FIRST',F9.4,'" ARE OMITTED'/)
C*********** JUNE 1,71
IT(J)=IT(J)/10
GO TO 1108
315 IF(IT3.GT.1)WRITE(JOUT,7154),ICT
IF(OP1.NE.0)WRITE(JOUT,4154),OP1
1601 IF(NWX.GT.1) GO TO 1108
IF(MZ)WRITE(JOUT,1023),ISLAC,PLAY
IF(TF.GT.10.)TF=TF/60.
TF=1000./TF
DO 6015 K=1,30
6015 COPY(K)=-9900.
C INITS PARAM REPRESSION FEATURE.
IF(KB.EQ.0)GO TO 9926
ML=NINS+1
NL=NINS+KB
DO 9826 K=ML,NL
9826 BG(K)=OTH(K-NINS,1)
C 'OTH' INSERTS, WITH BG TIME IN SECONDS, CAN ONLY BE SET WITH TF=1
9926 DO 5015 K=1,NINS
IQ(K)=BG(K)*10000.
BG(K)=0
INP(K)=0
P1(K)=0
IF(DUR(K).LT.10000.)DUR(K)=DUR(K)-.0001
C******* FEB. 16,71 FOR ROUND-OFF NONSENSE
5015 CNT(K)=0
IF(MX)WRITE(1,1023)ISLAC,PLAY
BW=0
GO TO 500
752 FORMAT(1X15A5)
1108 M=0
JC=0
IF(NWZ)GO TO 1740
C NWZZ IS SET AT 3111 IN SORTR.
DO 740 K=1,NWZZ
X=BNW(K)
IF(X-.0001.GT.BT.OR.X.LE.BW.OR.BW)GO TO 2740
IT(J)=IT(J)*10
NW=K
GO TO 600
2740 IF(X.LT.1000..OR.X-J*10000.NE.CNT(J)+1.)GO TO 740
X=BT+PR
NW=K
BX=CNT(J)+1.
IT(J)=-3
GO TO 600
740 CONTINUE
IT(J)=0
1740 IF(J.LE.NINS)GO TO 31
7021 K=J-NINS
IF(JC.GT.0)K=JC
5740 IF(PP1.LT.OP1)GO TO 1752
IF(MZ)WRITE(JOUT,752),(OTH(K,L),L=2,16)
IF(MX)WRITE(1,752)(OTH(K,L),L=2,16)
C IF TF .NE.1, ALL INSERT TIMES MUST BE RESET
C IF FIRST PART OF NOTE LIST IS 'OMITTED', CHECK YOUR 'INSERTS'.
DO 17521 L=3,30
17521 COPY(L)=-9900.
C SO THAT ALL PARAMS WILL PRINT,AFTER AN INSERT.
1752 BG(K+NINS)=19999.
OTH(K,1)=19999.
IF(JC.GT.0)GO TO 21
31 KL=1
IF(KB.EQ.0)GO TO 2031
DO 1031 L=1,KB
K=L
X=OTH(K,1)-1000000.
M=X/100000.
IF(M.NE.J.OR.IQ(J).NE.0)GO TO 1031
C M=INST
IF(X-M*100000.EQ.CNT(J)+1)GO TO 5740
1031 CONTINUE
IF(J.GT.NINS)GO TO 500
2031 CNT(J)=CNT(J)+1
ICT=CNT(J)
C INSERT TRAP HERE FOR OVERLAP OF RESTARTED INSTS.******
NPA=NP(J)
PP1=P1(J)
IF(BT.GE.DUR(J))GO TO 5174
IF(IQ(J).EQ.0)GO TO 200
P2=-IQ(J)/10000.
IQ(J)=0
CNT(J)=-1
ICT=-1
GO TO 4203
C MK IS FLAG FOR RESTS
200 MK=0
IF((BT.EQ.0.AND.J.EQ.1).OR.IPT(J,1).EQ.0)GO TO 203
KN=IPT(J,1)-1
IF(KN.GT.0)GO TO 12033
12032 KN=JPT(-KN)
IF(KN)GO TO 12032
KN=KN-1
C FOR 'ALL' IN P32. FOLLOWS UP ON POINTERS TO POINTERS!
C SOMEDAY PUT P1(32) IN WITH OTHER PARAMS BELOW!!!!
12033 IJ=V(KN)
IF(ABS(V(KN)).EQ.4.)GO TO 1203
C 'IABS' IS FOR -4 USED WITH 'ALL'
Z=(BT+9900.+V(KN-2))/V(KN+2)
C******* FEB 19,71
IF(Z.GT.1.)Z=1.
Y=V(KN+3)
X=(V(KN+4)-Y)*Z+Y
C******* FEB 19,71
GO TO 204
1203 X=V(KN+3)
204 Y=RAND(0.0,1.0)
IF(Y-X)MK=-1
203 DF=1.
C DF=DUTY FACTOR
DO 2155 L=2,NPA
ISUB=0
C WHY DOES ISUB APPEAR AT 14700/5?
IDF=0
C IDF IS DUTY FACTOR FLAG
IJ=IPT(J,L)
12031 IF(IJ)IJ=JPT(-IJ)
IF(IJ)GO TO 12031
C FOLLOWS UP ON POINTERS TO POINTERS!
PM=1.
IF(IJ.GT.1)GO TO 2157
P(L)=0
GO TO 21551
C 7/73
2157 LN=IJ+2
NM=ABS(V(IJ-1))+LN-4
NL=V(IJ)
IF(NL.GT.-200)GO TO 372
ISUB=-1
NL=NL+200
C FOR SUBROUTINE FLAG
372 IF(NL.GT.-100)GO TO 272
IDF=-1
NL=NL+100
C DEC.6,72 FINDS DUTY FACTOR PARAM
272 VIJ2=V(IJ+1)
KN=NL/(-11)
IF(KN.EQ.0)GO TO 1100
GO TO (61,62,62,62,65,65,67,68),KN
1100 IF(VIJ2.EQ.1.)GO TO 1200
ML=3
1900 KA=1
VX1=0
DO 1156 K=LN,NM,ML
VX(KA+1)=V(K)+VX(KA)
1156 KA=KA+1
X=RAND(0.0,1.)
DO 1157 K=2,11
IF(X.GT.VX(K))GO TO 1157
KL=K-1
IF(KN.EQ.7)GO TO 6157
GO TO 1400
1157 CONTINUE
1400 LN=IJ+3*KL
1462 RA=V(LN)
IF(RA.EQ.10000.)GO TO 5174
C FOR "FINE" IN RLIST
RB=V(LN+1)
PAR=RAND(RA,RB)
1300 IF(NL.NE.-1)PM=2.
C IF 2 THEN PRINTS A5
GO TO 1155
1200 PAR=V(IJ+2)
GO TO 1300
C NEXT IS FOR SUBROUTINE AND QUAD CALLS
61 IF(NL.LT.-12)GO TO 6100
601 X=P2
C '.5' MAKES ALL SUBR PARAMS PRINTOUT.
CALL SUBR
CC 7/74 NOW SET DUR(J) =0 IN SUBR IF(DF)GO TO 5174
C* OUT--COLGATE DF=-1 IN 'SUBR' WILL CAUSE 'END' FOR INST.
IF(L.EQ.2)GO TO 4203
IF(X.EQ.P2)GO TO 21552
PP2=P2
PR=P2
GO TO 21552
C ABOVE IS FOR P2 CHANGES IN SUBROUTINE
C TF,TEMPO,CONDUCT WILL AFFECT P2 ONLY WHEN P2 CALLS THE SUBR.,
C ALL 'TEMPO' CHANGES WILL BE IGNORED!! (THEN DUR. IN SECS. MUST
C BE SET TO 'REAL TIME'.)
C NEXT IS FOR QUAD ROUTINES
6100 CALL QUAD(NL)
GO TO 21552
C FOLLOWING IS FOR STRINGS OF VALUES.
62 KL=NCNT(J,L)+1
IF(KL.GT.VIJ2)KL=1
IF(NL.NE.-46.AND.NL.NE.-36)GO TO 162
C THIS PART FOR STRINGS OF RAND SELECTION
LN=KL+IJ+1
KL=KL+1
IF(KL.GT.VIJ2)KL=1
NL=NL+45
C FOR NUMBERS ONLY SO FAR(THIS MAKES NL=-1. FOR NOTES, =9)
162 NCNT(J,L)=KL
IF(NL.GT.-22)GO TO 1462
C JUMP RAND SELECTION
PAR=V(IJ+KL+1)
C********** MAY 13,71 RHY REPEAT FEATURE OMITTED.
C************************
IF(KN.NE.3)GO TO 1155
C*******JULY 16,71 IF(PAR.EQ.101.)GO TO 5174
IF(PAR.EQ.10000.)GO TO 5174
PM=2.
IF(PAR.GT.100..OR.PAR.LT.1.)PM=3.
IF(PAR.EQ.85.)MK=-1
GO TO 5155
65 W=-9900.-V(IJ-3)
C W=BG TIME OF MOVE.
X=ABS(V(IJ-1))
IF(NL.EQ.-56.OR.NL.EQ.-58)PM=2.
Z=(BT-W)/VIJ2
C Z= % OF WAY THROUGH.
IF(Z.GT.1.)Z=1.
Y=V(LN)
W=V(IJ+3)
IF(X.EQ.7.)W=V(IJ+4)
IF(NL.LT.-58)GO TO 16002
PAR=(W-Y)*Z+Y
IF(X.EQ.7.)GO TO 1600
GO TO 1155
C************** JUNE 1,71
C FOR "MOVX"
C******** FEB/73
C THE .01 IS NEEDED FOR MOVE TO OR FROM 0.
16002 PAR=RMOVX(W,Y,Z)
C SEE FUNCTION RMOVX 6/74 -- CAN'T HAVE -20→+20, ETC., -20→-40 OK.
C THIS NEEDS WORK!
IF(X.NE.7.)GO TO 1155
W=V(IJ+5)
Y=V(IJ+3)
X=RMOVX(W,Y,Z)
GO TO 16003
C NEXT IS FOR MOVING RAND RANGES.
C1600 PAR=(V(IJ+4)-Y)*Z+Y
1600 W=V(IJ+3)
C*********** BACK TO 65 IS NEW. FEB. 15,71
X=(V(IJ+5)-W)*Z+W
C************ JUNE 1,71
16003 PAR=RAND(PAR,X)
GO TO 1155
67 LN=IJ+3
NM=LN+VIJ2-1
ML=1
GO TO 1900
4155 K=(PAR-9999.0)*100.+.1
P(L)=P(K)
IF(L.EQ.2.AND.K.EQ.2)P2=PX2
C PX2=LAST UNPROCESSED VALUE OF P2 (+ OR -) 7/74
PM=PL(K)
GO TO 21551
C ANY # OVER 9999. REPEATS ANOTHER PARAM.(9999.21 REPEATS P21)
C 7/74 **** NOTE PROBLEMS OF P2 WITH SUBR, TEMPO, TF AND RAND. TF.
C ALSO DF. THE REAL TIME VALUE PRINTED MAY HAVE GONE THROUGH MANY
C CHANGES. HENCE WHEN TRANSFERING THE VALUE TO OTHER PARAMS OR
C INSTS GREAT CARE MUST BE TAKEN TO BE SURE THE RESULTS ARE CORRECT.
6157 LN=V(LN-1)
DO 1068 K=1,KL
1068 IF(K.LT.KL)LN=LN+V(LN)+1
2068 PM=LN+1
PAR=LN+V(LN)
GO TO 5155
68 KL=NCNT(J,L)
IF(KL.EQ.0.OR.KL.EQ.10000)KL=VIJ2
PM=KL+1
PAR=PM+V(KL)-1
KL=PAR+1
IF(V(KL).EQ.10000.)DUR(J)=BT
C 'END' OR 'FINE' IN 'LIT' LIST.
IF(V(KL).EQ.999.)KL=IJ+2
NCNT(J,L)=KL
GO TO 5155
C ******* JAN 20 *************
1155 IF(PAR.EQ.10000.)GO TO 5174
C TYPE 'END' OR 'FINE' AS LAST IN ANY STRING TO SET DURATION.
IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
C****JULY 16,71 1155 IF((PAR.GT.9999.).AND.(PM.EQ.1.))GO TO 4155
5155 P(L)=PAR
21551 PL(L)=PM
IF(ISUB)GO TO 601
IF(L.EQ.2)GO TO 4203
21552 IF(IDF.GE.0)GO TO 2155
DF=PAR
C DUTY FAC. IS ALWAYS % OF P2 - WHETHER CONSIDERING BASIC OR REAL TIME.
IDF=0
2155 CONTINUE
9203 IF(KB.EQ.0)GO TO 1170
NL=KB
DO 2203 K=1,KB
X=OTH(NL,1)
IF(X.LT.100000.)GO TO 2203
L=X/100000.
Y=(X-L*100000.)/100.
IX=Y
JC=NL
IF(J.EQ.L.AND.IX.EQ.ICT)GO TO 5203
2203 NL=NL-1
GO TO 1170
4203 PR=P2
PX2=P2
C TO SAVE THE UNPROCESSED P2 FOR 'P2 P2;' IN INPUT. 7/74
IF(T5.EQ.0)GO TO 7203
IF(IT3.LE.1.OR.BT.LT.TBG+TDUR)GO TO 6203
3155 IT3=IT3+3
TBG=TBG+TDUR
TDUR=V(IT3)
IF(BT.GE.TBG+TDUR)GO TO 3155
T1=V(IT3+1)
T2=V(IT3+2)
CALL SQYY(AC,T1,T2,TDUR)
6203 RA=PR
IF(BT.EQ.TBG)XT(J)=T1
K=IT3
RC=0
RD=1
KA=1
RB=0
Z=TDUR+TBG-BT
X=T1
Y=T2
YY=AC
CHN=TBG
ZZ=TDUR
GO TO 4020
8203 P2=RA*RD
7203 P2=P2*T4
X=P2*TF
C P2 IS KEPT WITHOUT TF*
K=X+.5
IF(X)K=X-.5
72031 ROFF(J)=ROFF(J)+K-X
IF(ABS(ROFF(J)).LT.1.)GO TO 7155
Y=1.
IF(ROFF(J))Y=-1.
K=K-Y
ROFF(J)=ROFF(J)-Y
C ROUND-OFF GAP WILL NOT EXCEED .001
C*********** FEB 17,71
7155 PP2=K/1000.
C AVOIDS ROUND-OFF PROBLEMS
C AFTER ALL THIS P2 IN SUBR MAY NOT EQUAL PP2(REAL TIME) DF COMES LATER!
IF(IPT(J,31).EQ.0)GO TO 6155
IF(ICT)GO TO 1170
X=V(IPT(J,31)+2)/2.
Y=RAND(-X,X)
IF(PP2.GE.0)GO TO 615
MK=-1
PP2=-PP2
615 PP2=PP2-RDEV(J)+Y
RDEV(J)=Y
C TOTAL RAND DEV. WON'T EXCEED P31
C SET P31 TO .0001 TO BRING VOICE BACK TO EXACT TIME(0 WON'T DO IT)
K=PP2*1000.+.5
C****** CHECK THIS OUT 1/10/72 :::::::
61551 PP2=K/1000.
C NEVER MORE THAN .1( DEVIATION WITH RAN TF. (RTF=.05)
6155 IF(ICT)GO TO 9203
GO TO 2155
5203 JD=Y*100-IX*100+.5
IF(JD.GT.0)GO TO 3203
M=0
P1(J)=PP1+PP2
GO TO 7021
3203 P(JD)=OTH(JC,2)
X=OTH(JC,3)
IF(X.NE.1.)X=3.
C 'EDITS' PRINT,NUM. OR 5 CHARS.
PL(JD)=X
C NEXT ADDED NOV.72 CHECK FOR SIDE AFFECTS !!!!! **********
IF(JD.EQ.2)PP2=P2
C 'TF' AND 'TEMPO' WILL NOT AFFECT PP2 'EDITS'.
1170 IF(MK.OR.PP2)GO TO 2022
ZPAR=PP1
P1(J)=PP1+PP2
C ZPAR IS USED HERE WHEN OP1(OMIT) IS .GT.0. OMIT IS IN REAL TIME.
LK=INST(J)
2021 IF(PP1.LT.OP1)GO TO 2612
IF(INVIS(J).LT.0)GO TO 2170
C ALL PARAMS WILL PRINT,1ST TIME WHEN USING 'OMIT'.
IF(INONLY.GT.0)GO TO 1204
C*********** MAY 16,71 ↑↑↑
6021 IF(P(NPA).NE.COPY(NPA).OR.PL(NPA).GT.1)GO TO 5021
C******* MAY 25,71
C 'LIT' DATA WILL ALWAYS PRINT.
NPA=NPA-1
IF(NPA.GT.2)GO TO 6021
5021 DO 1304 K=3,NPA
1304 COPY(K)=P(K)
1204 IF(PL4.NE.1.)GO TO 2170
P4=P4*AMPFAC
L=0
INP(J)=P4
DO 1021 K=1,NINS
1021 IF(P1(K).GT.PP1)L=L+INP(K)
IF(L-IAMP-1)GO TO 2170
IAMP=L
AMPTIM=PP1
2170 IF(MX.EQ.3)GO TO 2612
C ********* MAY 17,71
PP1=PP1-OP1
C PUTS SPACES BETWEEN NOTES .GT. .05( APART
IF((MZ.NE.-1).OR.(A.GE.PP1))GO TO 5170
IF(INONLY)WRITE(JOUT,902)
A=PP1+.05
5170 ML=10
IF(NPA.LT.10)ML=NPA
MLX=3
NL=2
IF(INVIS(J).EQ.0)GO TO 3170
LK=0
C NEEDED TO INIT INVISIBLE MODE PRINT-OUT (NO INST NAME, P1, P2)
C NEXT CREATES FORMAT DATA IN IFM ARRAY.
31701 KL=3
GO TO 4170
3170 IF(.NOT.INONLY.AND.J.NE.INONLY)GO TO 2612
VX(1)=PP1
IF(DF.GT.0)GO TO 6170
VX2=-DF
IF(VX2.GT.PP2)VX2=PP2
C NEG. DF=FIXED NOTE DUR. NOT.GT.PP2 7/74 COLGATE -AND BELOW
GO TO 7170
6170 IF(DF.LT.100)GO TO 8170
C DF>100 = FIXED REST AREA BEFORE NEXT ATTACK.
VX2=PP2-DF+100.
IF(VX2.LE.0)VX2=PP2/2.
C NO NEG. TIME VALUES ALLOWED.
GO TO 7170
8170 VX2=PP2*DF
7170 IFM3='F9.3,'
IFM4=IFM3
KL=5
IF(NPA.LT.3)GO TO 2121
4170 NL=2
DO 1121 K=MLX,ML
X=P(K)
L=PL(K)
IF(L-2)321,521,621
C L=1 NUMBS, =2 NOTES,FUNCS, =3 LITS.
321 IF(X.GE.0)GO TO 4211
IFM(KL)=IFCOM
NL=NL+1
KL=KL+1
4211 IFM(KL)='F9.3,'
C CREATES 'F9.3'
421 VX(KL-NL)=X
GO TO 1121
521 IFM(KL)=IFM2
C CREATES '1XA5'
LN=X
VX(KL-NL)=SCAL(LN)
GO TO 42
621 IF(L.GT.3)GO TO 721
VX(KL-NL)=X
C ABOVE LETS A5 WD BE USED IN SUBR BY SETTING PL(N)=3.
42 IFM(KL)=IFM2
GO TO 1121
721 LN=X
IFM(KL)=I1X
NL=NL+1
DO 821 M=1,LN-L+1
KL=KL+1
IOUT(KL-NL)=IV(L-1+M)
821 IFM(KL)=IA1
1121 KL=KL+1
C NO MORE THAN 80 ITEMS IN FORMAT.
2121 IF(KL.LE.80)GO TO 21211
21212 FORMAT(' ERROR! TOO MANY LIT. ITEMS')
TYPE 21212
21211 DO 921 M=KL+1,80
921 IFM(M)=IBLA
IFM(KL)=')'
L=KL-NL-1
IF(MX)WRITE(1,IFM)LK,(VX(K),K=1,L)
IF(.NOT.MZ)GO TO 30210
IF(ML.GE.NPA)IFM(KL)='$)'
WRITE(JOUT,IFM),LK,(VX(K),K=1,L)
30210 IF(ML.GE.NPA)GO TO 3021
MLX=ML+1
ML=ML+10
IF(ML.GT.NPA)ML=NPA
LK=IBLA
GO TO 31701
3021 IF(MX)WRITE(1,3616)INST(J),ICT
30211 IF(MZ)WRITE(JOUT,8902),J,INST(J),ICT,BT
2612 PP1=ZPAR
GO TO 21
8902 FORMAT('+;<'I2,1XA5,I4,' >',F7.3)
3616 FORMAT(';PRINT(P1);< ',A5,I4)
C PRINTS RESTS
2022 PP2=ABS(PP2)
C IN THIS VERSION TYPE 'R' FOR RESTS IN ANY PARAM BUT P2.
C FOR RESTS IN SEQS. TYPE -DUR.
C WHEN RANDOM RESTS ARE CHOSEN, SEQS. MISS NOTES.
C RAN RESTS ARE TOUCHED BY SUBROUTINES ONLY BY SETTING IREST!!
INP(J)=0
P1(J)=PP1+PP2
C STORES NEXT P1 TIME FOR THIS INST.
IF((MZ.NE.-1).OR.(PP1.LT.OP1))GO TO 21
X=PP1-OP1
IF(A.GE.X)GO TO 121
WRITE(JOUT,902)
A=X+.05
121 IF(INONLY.OR.J.EQ.INONLY)WRITE(JOUT,1110),INST(J),X,PP2,
1 J,INST(J),ICT
21 PR=ABS(PR)
BG(J)=BT+PR
IF(ICT.EQ.DUR(J)-10000.)GO TO 5174
IF(BG(J).LT.DUR(J))GO TO 500
5174 BG(J)=19999.
DO 3174 K=1,NINS
C INSERTS CANT FOLLOW LAST REGULAR NOTE.
C (ADD REST IF INSERT AT END IS NEEDED.)
3174 IF(BG(K).LT.19999.)GO TO 500
GO TO 175
C CHOOSES INST WITH NEXT BEGIN TIME.
500 J=1
BW=BT
NL=NINS+KB
DO 22 K=2,NL
22 IF(BG(J).GT.BG(K))J=K
IF(J.GT.NINS.OR.NINS.EQ.1)GO TO 3022
J=1
DO 5022 K=2,NINS
X=P1(J)
Y=P1(K)+.0001
C LOWEST NUMBERED INST WILL COME 1ST IF BG TIMES ARE VERY CLOSE
IF(BG(J).EQ.19999.)X=19999.
IF(BG(K).EQ.19999.)Y=19999.
5022 IF(X.GT.Y)J=K
C ABOVE IS FOR ROUND-OFF PROBLEMS WITH 'TEMPO' AND 'CONDUCT'.
3022 BT=BG(J)
IF((BT.EQ.19999.).OR.(P1(J).GE.DURX))GO TO 175
IF(CNT(J).GT.0)GO TO 1022
IF(CNT(J).EQ.0)P1(J)=0
IF(CNT(J).EQ.-1)CNT(J)=0
C N.B. 'TF' CONTROLS BG TIME WHEN BG .GT. 0
1022 IF((BT.LT.T6).OR.(IT3.GT.1))GO TO 1108
T4=T2
T5=0
T6=10000.
GO TO 1108
1175 FORMAT('+',A5,'=',F7.3,2X,$)
1109 FORMAT(' FINISH; < ',A5,'.DAT')
1110 FORMAT(' <',A5,2F9.3,2X,'******* REST <'I2,1XA5,I4)
1603 FORMAT(' AMPL. FACTOR=',F4.2,', P4 MAX.AMP.=',I4,', AT TIME'
1,F8.3)
175 IF(MZ)WRITE(JOUT,1109),ISLAC
IF(MX.GE.0)GO TO 4175
WRITE(1,1109),ISLAC
END FILE 1
603 FORMAT(' TOTAL DURS: ',$)
CC FOR COLGATE ONLY***4175 CALL ENDSUB
C CLEARS CNTL O --- IF YOU HAVE HIT IT.
4175 WRITE(JOUT,1603),AMPFAC,IAMP,AMPTIM
WRITE(JOUT,603)
5175 DO 2175 K=1,NINS
X=P1(K)-OP1
IF(MZ)GO TO 6175
TYPE 1175,INST(K),X
GO TO 2175
6175 WRITE(JOUT,1175),INST(K),X
2175 CONTINUE
3175 TYPE 1023,ISLAC
END